The Business Master (3rd Edition)/The Business Master (3rd Edition).iso/files/business/barcode/bar39.pas

Pascal/Delphi Source File | 1990-08-03 | 12.2 KB | 376 lines

{The following program was modified for 24 pin printers by John Beckwith
 on 7-29-90. Lines from the 9 pin version are left as comments.}
program barcode; { Logmars (Code 39) barcode routines for Epson type printers
                by: Cliff Knight, 6 Janebar Circle, Plymouth, MA  02360
                    [phone], CIS ID# 71106,1153,  Version 08/05/87

modified by lon rolland on 7/12/88 for: 1) code 39 only 2) command line driven
3) to output four lines; a description, the barcode itself, its corresponding
number, and finally a second description on the bottom.
4) compile under tp4 to be run from dbase 5) a back slash delimitor between
the descriptor group and the code group, (note) I check up to a maximum of
twelve parm strings on the command line input

example: bar39 maytag repairman #2\12345-67-89 A xx xx\Southern Route Area #1
would produce a result of:

                MAYTAG REPAIRMAN #2
                || ||| | |||| ||| ||| |
                || ||| | |||| ||| ||| |    (label stock is 1 1/2 by 4 inches)
                || ||| | |||| ||| ||| |
                12345-67-89 A XX XX
                SOUTHERN ROUTE AREA #1

this thing has been modified more than a dozen times. the most recent request
came from paul mincone in the boston office. there has been a big chance in
how the parm string is fetched and we added the fourth line. }

{$V-,D-,I-,R-,S-} { lets 'JUST SAY NO' to checking, lets turn it off }

uses Printer;

{NOTE: all types and variables with '' as 1st two chars
       are globally required by the barcode routines}

const
  slash = '\';
type
  Str5   =string[5];
  Str10  =string[10];
  Str80  =string[80];
  StrMax =string[255];

var
  BCArrary     :array[0..1000] of byte;
  BCArraryLen  :integer;
  GraphLen  :integer;
  KWide     :integer;
  KNarr     :integer;
  Passes    :integer;
  i         : byte;
  found       :boolean;
  line        :Str80;
  spot          :integer;
  Sequence      :Str80;
  Desc1            :Str80;
  Desc2            :Str80;
  CType         :char;
  Size          :integer;
  Density       :integer;

{***** BarCode Routines *****}

function UpCaseStr (s :StrMax) :StrMax;
var
  j :integer;
begin
  for j:=1 to length(s) do
    s[j]:=upcase(s[j]);
  UpCaseStr:=s;
  end;         {NOTE: both 'Init' & 'Print' routines use this function}

procedure PrintBarCode (ho,vs,ve,fl,ht :integer; sq,de1,de2 :Str80; vx :integer);

{          ho = horizontal offset in 120th's of an inch...
           vs = vertical offset (+ or -) at start of barcode
                in 216th's of an inch...
           ve = vertical offset (+ or -) at end of barcode
                in 216th's of an inch...
                NOTE: Set ve = -(ht-1)*23 to 'back-up'
                for "side-by-side" codes...
           fl = barcode field length in 120th's of an inch
                barcode will be centered in this field,
                use fl=0 to print left, upper corner
                at (ho,vs)...
           ht = number of graphics passes/barcode
                  (1 pass = 23/216th's inch)...
           sq = sequence string to be printed under barcode
                  (set to '' if not wanted)
           vx = vertical offset to align a new label
           de1,de2 = description on top, description on bottom }
var
  f,h,i,j,k,l,m  :integer;
  vc,gch         :char;

  procedure HorizGTab (n :integer);   {offset barcode left n/120"}
  begin
    write(lst,#27,'L',chr(lo(n)),chr(hi(n)));
    while n > 0 do
    begin
      write(lst,#0);
      n:=pred(n);
    end;
  end;         {HorizGTab}

  procedure VerticalGTab (n :integer);    {move paper +/- n/216"}
  begin
    if n <> 0 then begin
      if n > 0 then
        vc := 'J'
      else
        vc:='j';
      write(lst,#27,vc,chr(abs(n)));
      end;
    end;

  procedure DoHorizTabs (x1,x2 :integer);
  begin
    if x1>0 then
      HorizGTab(x1);
    if x2>0 then
      HorizGTab(x2);
    end;

  procedure PrintHRI (s :Str80);    {print centered HRI}
  begin
    s:=UpCaseStr(s);
    writeln(lst);   { this one advances the paper after the barcode }
    write(lst,#14,#27,'G'); {set enlarged(14)/double strike mode}
    write(lst,s,#20,#27,'H');   {reset enlarged(20)/double strike}
    end;

begin
  k:=(fl-GraphLen) div 2;
  PrintHRI(de1);
  VerticalGTab(vs);
  for h:=1 to ht do
  begin
    for m:=1 to Passes do begin
      write(lst,#13);
      DoHorizTabs(ho,k);
{old line:      write(lst,#27,'L',chr(lo(GraphLen)),chr(hi(GraphLen)));}
      write(lst,#27,'*',#33,chr(lo(GraphLen)),chr(hi(GraphLen)));
      f:=1;
      for i:=1 to BCArraryLen do begin
        f:=swap(f);
        gch:=chr(hi(f)*$ff);
        for j:=1 to BCArrary[i] do
{old line:          write(lst,gch);}
          write(lst,gch,gch,gch);
        end;
      write(lst,#13);
      end;
    if h<ht then
{old line:      write(lst,#27,'J',#23);}
      write(lst,#27,'J',#24);
    end;
  PrintHRI(sq);
  PrintHRI(de2);
  VerticalGTab(vx);
  end;               {PrintBarCode}

{*************************************************************}

procedure InitBarCode (s :Str80; z,d :integer; t :char);

{           s = sequence to be encoded
            z = size, number of columns in narrow bar
            d = density, number of print head passes per graphic line
            t = type, '3' = "3 of 9", '2' = "I 2 of 5"
}

  procedure Fill39BCArrary (c :char);
  var
    s         :Str10;
    e,h,i     :integer;
  begin
    c:=UpCase(c);
    case c of
      ' ' : s:='0110001000';
      '$' : s:='0101010000';
      '%' : s:='0001010100';
      '*' : s:='0100101000';
      '+' : s:='0100010100';
      '-' : s:='0100001010';
      '.' : s:='1100001000';
      '/' : s:='0101000100';
      '0' : s:='0001101000';
      '1' : s:='1001000010';
      '2' : s:='0011000010';
      '3' : s:='1011000000';
      '4' : s:='0001100010';
      '5' : s:='1001100000';
      '6' : s:='0011100000';
      '7' : s:='0001001010';
      '8' : s:='1001001000';
      '9' : s:='0011001000';
      'A' : s:='1000010010';
      'B' : s:='0010010010';
      'C' : s:='1010010000';
      'D' : s:='0000110010';
      'E' : s:='1000110000';
      'F' : s:='0010110000';
      'G' : s:='0000011010';
      'H' : s:='1000011000';
      'I' : s:='0010011000';
      'J' : s:='0000111000';
      'K' : s:='1000000110';
      'L' : s:='0010000110';
      'M' : s:='1010000100';
      'N' : s:='0000100110';
      'O' : s:='1000100100';
      'P' : s:='0010100100';
      'Q' : s:='0000001110';
      'R' : s:='1000001100';
      'S' : s:='0010001100';
      'T' : s:='0000101100';
      'U' : s:='1100000010';
      'V' : s:='0110000010';
      'W' : s:='1110000000';
      'X' : s:='0100100010';
      'Y' : s:='1100100000';
      'Z' : s:='0110100000'
    end;    {case}
    for h:=1 to 10 do
    begin
      BCArraryLen:=succ(BCArraryLen);
      BCArrary[BCArraryLen]:=(ord(s[h])-48)*KWide+KNarr;
    end;
  end;             {Fill39BCArrary}

  procedure ScanSequence (s :Str80; t :char);
  var
    h,i       :integer;
    ws        :Str5;
    es,os     :Str80;
    is        :StrMax;
  begin
    BCArraryLen:=0;
    s := '*' + s + '*';    {like the old one!!!}
    i:=1;
    es[0] := #0;
    os[0] := #0;
    for h:=1 to length(s) do
      begin
        Fill39BCArrary(s[h]);
      end;        {for..to}
  end;             {ScanSequence}

  procedure GetGraphLen;
  var
    f,j,i     :integer;
  begin
    f:=1;
    GraphLen:=0;
    for i:=1 to BCArraryLen do
    begin
      f:=swap(f);
      for j:=1 to (BCArrary[i]+lo(f)) do
        GraphLen:=succ(GraphLen);
        BCArrary[i]:=BCArrary[i]+lo(f);
    end;
  end;             {GetGraphLen}

begin
  KWide:=z*2;
  KNarr:=z;
  Passes:=d;
  s:=UpCaseStr(s);
  ScanSequence(s,t);
  GetGraphLen;
end;               {the end of InitBarCode}

{*************************************************************}

function find_delim(var str : Str80) : str80;
begin
  found := false;
  spot := pos(slash,str);  { does this line have a back slash? }
  if spot <> 0 then        { if we finally got it, then... }
    begin
      find_delim := copy(str,1,pred(spot));
      delete(str,1,spot);
      found := true;
    end
  else
    find_delim := str; { pass back the whole thing }
end;

{- - - - - - - - - - - M A I N - - - - - - - - - - -}

begin
    CType:='3';  { code39 }
    Size := 1;
    Density := 1;
    line[0] := #0;      { smarter, less code method }
    Desc1[0] := #0;
    Desc2[0] := #0;
    Sequence := #0;
    if paramcount > 0 then
      begin
        for i := 1 to paramcount do    { build to param string }
          begin
            line := line + paramstr(i) + ' ';
          end;
        Desc1    := find_delim(line);
        if not found then            { check for error }
          begin
            writeln('ERROR, no delimitor (the back slash) ',
                    'to show where the description ends');
            writeln('and the barcode sequence begins.');
          end;
        Sequence := find_delim(line);
        if not found then            { check for error }
          begin
            writeln('ERROR, no delimitor (the back slash) ',
                    'to show where the barcode ends');
            writeln('and the barcode sequence begins.');
          end;
        Desc2    := line;  { the remainder goes on the bottom line }
        if found then
          begin
            writeln('top desc."',Desc1,'" barcode "',Sequence,
            '" bot.desc."',Desc2,'" ');
            write(lst,#13,#10);
{ following initializes barcode graphics array... }

            InitBarCode(Sequence,Size,Density,CType);

{ this is the call to the 'PrintBarCode' procedure...
  the passed parameters are as follows:
              10 = 'ho'= horizontal offset for barcode (in 120ths/inch)
              40 = 'vs'= vert. motion "before" printing code (in 216ths/inch)
-((Size*2-1)*23) = 've'= vert. motion "after" printing code (in 216ths/inch)
                   NOTE: The height 'ht' following is defined as 'Size*2'.
                   therefore the paper will be advanced (Size*2-1)*23)/216ths
                   of an inch in printing this bar.  Specifying a negative
                   vertical motion after printing the code will move the
                   paper backward and allow the second bar to be printed at
                   the same vertical position on the paper.
               0 = 'fl'= field width for centering of code (in 120ths/inch)
was - - - -  Size*2 = 'ht'= the height of the barcode (in 23/216ths inch units)
changed to size*3 for increasing the height of the barcode itself!!!
        Desc1 =  a description of the item to print first
             95 = 'vx' = vert. motion to align print to a new label }

            PrintBarCode(10,40,-((Size*2-1)*23),0,Size*3,
                Sequence,Desc1,Desc2,95);

{ the number 95 is an alignment to advance the paper to the next label.
  the labels in use are 101 mm wide and 38 mm (1 ½ inches) tall }
          end;  { found = true }
      end  { paramcount > 0 }
    else
      begin
        writeln('I''m trying as hard as I can but you goofed up the input line again!');
        writeln('Please type it in as: "bc39 1st description\barcode number\2nd description".');
        writeln('The separator (or deliminator) is the simple back slash character.');
        writeln('The first description will be the name across the top of the barcode label.');
        writeln('Next comes the triple height, single pass barcode number (in CODE39).');
        writeln('Third, is the barcode number again, but this time in text format.');
        writeln('Fourth and finally comes the second description line for the bottom.');
        writeln('Please note that CODE39 can use letters and numbers both. Lower case');
        writeln('letters will be translated to uppercase letters. And finally spaces');
        writeln('are allowed in both the description parts and barcode parts.');
        writeln;
        writeln('example: bar39 maytag repairman #2\12345-67-89 AB xx xx\Southern Route Area #1');
        writeln('would produce a result of:');
        writeln('           MAYTAG REPAIRMAN #2      ');
        writeln('           || ||| | |||| ||| ||| || ');
        writeln('           || ||| | |||| ||| ||| || ');
        writeln('           || ||| | |||| ||| ||| || ');
        writeln('           12345-67-89 AB XX XX    ');
        writeln('           SOUTHERN ROUTE AREA #1   ');
      end;
end.